home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 1 / LSD Compendium Deluxe 1.iso / a / programming / misc / ada1110b.lha / Examples / Dine / ranbody.ada < prev    next >
Encoding:
Text File  |  1992-03-02  |  1.6 KB  |  57 lines
  1.  
  2. with CALENDAR;
  3. use  CALENDAR;
  4. package body RANDOM is
  5.  
  6. -- Body of random number generator package.
  7. -- Adapted from the Ada literature by
  8. -- Michael B. Feldman, The George Washington University, November 1990.
  9.  
  10.     MODULUS            : constant := 9317;
  11.  
  12.     type    INT_16     is range -2 ** 15 .. 2 ** 15 - 1;
  13.     type    INT_32     is range -2 ** 31 .. 2 ** 31 - 1;
  14.     subtype SEED_RANGE is INT_16 range 0 .. (MODULUS - 1);
  15.     SEED, DEFAULT_SEED : SEED_RANGE;
  16.  
  17.     procedure SET_SEED(N : POSITIVE) is separate;
  18.     function UNIT_RANDOM return FLOAT is separate;
  19.     function RANDOM_INT(N : POSITIVE) return POSITIVE is separate;
  20. begin
  21.     DEFAULT_SEED := INT_16(INT_32(SECONDS(CLOCK)) mod MODULUS);
  22.     SEED := DEFAULT_SEED;
  23. end RANDOM;
  24.  
  25. separate(RANDOM)
  26. procedure SET_SEED(N : POSITIVE) is
  27. begin
  28.     SEED := SEED_RANGE(N);
  29. end SET_SEED;
  30.  
  31. separate(RANDOM)
  32. function UNIT_RANDOM return FLOAT is
  33.     MULTIPLIER : constant := 421;
  34.     INCREMENT  : constant := 2073;
  35.     RESULT     : FLOAT;
  36. begin
  37.     SEED := (MULTIPLIER * SEED + INCREMENT) mod MODULUS;
  38.     RESULT := FLOAT(SEED) / FLOAT(MODULUS);
  39.     return RESULT;
  40. exception
  41.     when CONSTRAINT_ERROR | NUMERIC_ERROR =>
  42.     SEED := INT_16((MULTIPLIER * INT_32(SEED) + INCREMENT) mod MODULUS);
  43.     RESULT := FLOAT(SEED) / FLOAT(MODULUS);
  44.     return RESULT;
  45. end UNIT_RANDOM;
  46.  
  47. separate(RANDOM)
  48. function RANDOM_INT(N : POSITIVE) return POSITIVE is
  49.     RESULT : INTEGER range 1 .. N;
  50. begin
  51.     RESULT := INTEGER(FLOAT(N) * UNIT_RANDOM + 0.5);
  52.     return RESULT;
  53. exception
  54.     when CONSTRAINT_ERROR | NUMERIC_ERROR =>
  55.     return 1;
  56. end RANDOM_INT;
  57.